home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 011-020 / amok14 / timersupport / timersupport.mod < prev    next >
Text File  |  1993-11-04  |  6KB  |  248 lines
  1. (*********************************************************************
  2.  *                                                                   *
  3.  *  :Program.    TimerSupport.mod                                    *
  4.  *  :Author.     Hartmut Höhn                                        *
  5.  *  :Address.    Friedenstraße 1                                     *
  6.  *  :Address.    6255 Dornburg 5                                     *
  7.  *  :shortcut.   []                                                  *
  8.  *  :Version.    1.0                                                 *
  9.  *  :Date.       27.12.88                                            *
  10.  *  :Copyright.  PD                                                  *
  11.  *  :Language.   Modula-II                                           *
  12.  *  :Translator. M2Amiga                                             *
  13.  *  :update.     -                                      *
  14.  *                                                                   *
  15.  *********************************************************************)
  16.  
  17.  
  18. IMPLEMENTATION MODULE TimerSupport;
  19.  
  20. (* Copyright (c) in 1988 by Hartmut Höhn *)
  21.  
  22. FROM Arts        IMPORT Assert;
  23. FROM SYSTEM      IMPORT ADR,LONGSET;
  24. FROM Timer       IMPORT timerName,microHz,vBlank,TimeRequest,TimeVal,
  25.                         getSysTime,setSysTime,addRequest,TimeRequestPtr;
  26. FROM ExecSupport IMPORT CreatePort,DeletePort,CreateExtIO,DeleteExtIO;
  27. FROM Exec        IMPORT MsgPortPtr,DoIO,IOStdReqPtr,OpenDevice,CloseDevice;
  28. FROM MODIV       IMPORT Div;
  29.  
  30. VAR   TimerPort     : MsgPortPtr;
  31.       myVal         : TimeVal;
  32.       reqPtr        : TimeRequestPtr;
  33.       Monate        : ARRAY[0..11] OF INTEGER;
  34.       i             : INTEGER;
  35.  
  36. CONST micProSek    = 1000000;        (* Anzahl der MicroSek pro Sekunde *)
  37.  
  38.       sekProMin    = 60;             
  39.       sekProStunde = 60*60;          (* Definitionen der *)
  40.       sekProTag    = 60*60*24;       
  41.       sekProJahr   = 60*60*24*365;   (* Sekunden pro Zeiteinheit *)
  42.       sekProSJahr  = 60*60*24*366;
  43.  
  44. PROCEDURE CloseTimer;
  45.  BEGIN
  46.   CloseDevice(reqPtr);
  47.   DeleteExtIO(reqPtr);
  48.   DeletePort(TimerPort);
  49.  END CloseTimer;
  50.  
  51. PROCEDURE OpenTimer(mode : BOOLEAN);
  52.  VAR  myMode : INTEGER;
  53.  BEGIN
  54.   IF mode THEN
  55.    myMode := vBlank;
  56.   ELSE;
  57.    myMode := microHz;
  58.   END;
  59.  
  60.   TimerPort := CreatePort(ADR("MyTimer"),0);
  61.   Assert(TimerPort#NIL,ADR("Kann TimerPort nicht öffnen !!"));
  62.   reqPtr    := CreateExtIO(TimerPort,SIZE(TimeRequest));
  63.    IF reqPtr = NIL THEN
  64.     DeletePort(TimerPort);
  65.     Assert(FALSE,ADR("Kann ExtIO nicht öffnen"));
  66.    END; 
  67.   OpenDevice(ADR(timerName),myMode,reqPtr,LONGSET{});
  68.  END OpenTimer;
  69.  
  70. PROCEDURE TimerWait(Sek,micr : LONGINT);
  71. BEGIN
  72.   WITH myVal DO
  73.    secs  := Sek;
  74.    micro := micr;
  75.   END;
  76.   
  77.   WITH reqPtr^ DO
  78.     node.command := addRequest;
  79.     time := myVal;
  80.   END;
  81.  
  82.   DoIO(reqPtr);
  83. END TimerWait; 
  84.  
  85. PROCEDURE GetTimeLong(VAR Sek,micr : LONGINT);
  86.  BEGIN 
  87.    WITH reqPtr^ DO
  88.     node.command := getSysTime;
  89.     time := myVal;
  90.    END;
  91.  
  92.    DoIO(reqPtr);
  93.  
  94.    WITH reqPtr^.time DO
  95.     Sek  := secs;
  96.     micr := micro; 
  97.    END; 
  98. END GetTimeLong;
  99.  
  100. PROCEDURE GetTime(VAR Jahr,Monat,Tag,Stunde,Minute,Sekunde : LONGINT);
  101.  
  102.  VAR zw,n : LONGINT;
  103.       Va  : TimeVal;
  104. BEGIN
  105.  GetTimeLong(Sekunde,n);
  106.  
  107.  zw := Div(Sekunde,sekProTag);
  108.  DEC(Sekunde,zw*sekProTag);
  109.  
  110.  Stunde := Div(Sekunde,sekProStunde); 
  111.  DEC(Sekunde,Stunde*sekProStunde);
  112.  Minute := Div(Sekunde,sekProMin);
  113.  DEC(Sekunde,Minute*sekProMin);
  114.  
  115.   n:=zw-2251;
  116.   Jahr:=(4*n+3) DIV 1461;
  117.   n:=n-1461*Jahr DIV 4;
  118.   Jahr:=Jahr+84;
  119.   Monat:=(5*n+2) DIV 153;
  120.   Tag:=n-(153*Monat+2) DIV 5+1;
  121.   Monat:=Monat+3;
  122.   IF (Monat>12) THEN
  123.       Jahr:=Jahr+1;
  124.         Monat:=Monat-12;
  125.   END; (*IF*)
  126.  
  127. END GetTime;  
  128.  
  129. PROCEDURE SetTimeLong(Sek,micr: LONGINT);
  130. BEGIN
  131.   WITH myVal DO
  132.    secs  := Sek;
  133.    micro := micr;
  134.   END;  
  135.      
  136.   WITH reqPtr^ DO
  137.     node.command := setSysTime;
  138.     time := myVal;
  139.   END;
  140.  
  141.   DoIO(reqPtr);
  142. END SetTimeLong; 
  143.  
  144. PROCEDURE Test(VAR was : LONGINT;hoch,tief : LONGINT);
  145. BEGIN
  146.  IF (was > hoch) OR (was < tief) THEN
  147.   was := tief;
  148.  END;
  149. END Test;
  150.  
  151. PROCEDURE SetTime(Jahr,Monat,Tag,Stunde,Minute,Sekunde : LONGINT);
  152.  VAR zw  : LONGINT;
  153.  BEGIN 
  154.   
  155.   Test(Jahr   ,1999,1978);
  156.   Test(Monat  ,  12,   1);
  157.   Test(Tag    ,  31,   1);
  158.   Test(Stunde ,  23,   0);
  159.   Test(Minute ,  59,   0);
  160.   Test(Sekunde,  59,   0);
  161.   
  162.    zw := 0;DEC(Tag);DEC(Monat);
  163.   
  164.   IF ((Jahr MOD 4) = 0) THEN 
  165.    Monate[1] := 29;
  166.   ELSE
  167.    Monate[1] := 28;
  168.   END; 
  169.    
  170.   FOR i := 1978 TO (Jahr-1) DO
  171.    IF ((i MOD 4) = 0) THEN
  172.     INC(zw,sekProSJahr);
  173.    ELSE
  174.     INC(zw,sekProJahr);
  175.    END;
  176.   END; 
  177.    i := 0;
  178.   
  179.  IF Monat > 0 THEN 
  180.   REPEAT 
  181.    INC(zw,(Monate[i]*sekProTag));
  182.    INC(i);
  183.   UNTIL (i =  Monat);
  184.  END; 
  185.   INC(zw,(Tag*sekProTag));
  186.   INC(zw,(Stunde*sekProStunde));
  187.   INC(zw,(Minute*sekProMin));
  188.   INC(zw,Sekunde);
  189.   
  190.   SetTimeLong(zw,0);
  191.  
  192. END SetTime;
  193.  
  194. PROCEDURE SubTime(VAR t1,t2 : TimeVal);
  195. BEGIN
  196.  IF (t2.micro > t1.micro) THEN
  197.   INC(t1.micro,micProSek);
  198.   DEC(t1.secs);
  199.  END;
  200.  DEC(t1.micro-t2.micro);
  201.  IF t1.secs > t2.secs THEN
  202.   DEC(t1.secs,t2.secs);
  203.  ELSE
  204.  END;
  205. END SubTime;
  206.  
  207. PROCEDURE AddTime(VAR t1,t2 : TimeVal);
  208.  VAR   zw : LONGINT;
  209.  
  210. BEGIN
  211.  t1.micro := t1.micro+t2.micro;
  212.   IF (t1.micro > micProSek) THEN
  213.    zw := Div(t1.micro,micProSek);
  214.    DEC(t1.micro,(zw*micProSek));
  215.    INC(t1.secs,zw);
  216.   END;
  217.  t1.secs  := t1.secs+t2.secs;
  218.  
  219. END AddTime;
  220.  
  221. PROCEDURE CmpTime(VAR t1,t2 : TimeVal) : INTEGER;
  222.  VAR zur : INTEGER;
  223. BEGIN
  224.  IF (t1.secs > t2.secs) THEN
  225.   zur := 1;
  226.  ELSIF (t1.secs = t2.secs) THEN
  227.   IF (t1.micro > t2.micro) THEN
  228.    zur := 1;
  229.   ELSIF (t1.micro = t2.micro) THEN
  230.    zur := 0;
  231.   ELSE
  232.    zur := -1;
  233.   END;
  234.  ELSE
  235.   zur := -1;
  236.  END;
  237.  RETURN(zur);
  238. END CmpTime;
  239.  
  240. BEGIN
  241.   
  242.  Monate[0] := 31; Monate[1] := 28; Monate[2] := 31; Monate[3] := 30;
  243.  Monate[4] := 31; Monate[5] := 30; Monate[6] := 31; Monate[7] := 31;
  244.  Monate[8] := 30; Monate[9] := 31; Monate[10] := 30; Monate[11] := 31; 
  245.  
  246. END TimerSupport.
  247.  
  248.